home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / UTILITY / VIEW2DIM.I < prev   
Encoding:
Modula Implementation  |  1994-01-19  |  20.0 KB  |  635 lines
  1. IMPLEMENTATION MODULE View2Dim;
  2.  
  3. (*
  4.  * Thomas Tempelmann, 17.5.93
  5.  *
  6.  * Terminologie:
  7.  *  'wdw' ist immer vom Typ CellWindow,
  8.  *  'win' ist immer vom Typ WindowBase.Window,
  9.  *)
  10.  
  11. FROM SYSTEM IMPORT ASSEMBLER, ADR, ADDRESS;
  12. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  13. FROM GrafBase IMPORT MemFormDef, BitOperation, Point, Rectangle, black, white,
  14.         FramePoints, ClipRect, Rect, Pnt, LPnt, LongPnt, LongRect;
  15. FROM VDIRasters IMPORT CopyOpaque;
  16. FROM VDIControls IMPORT DisableClipping, SetClipping;
  17. FROM GEMEnv IMPORT RC, GemHandle, DeviceHandle, ExitGem, GemError,
  18.         InitGem, CurrGemHandle, SetCurrGemHandle, GemActive;
  19. FROM VDIAttributes IMPORT SetTextColor, SetTextEffects, SetFillColor,
  20.         SetFillType, SetFillPerimeter, SetWritingMode,
  21.         SetLineType, SetLineColor, SetLineWidth;
  22. FROM VDIOutputs IMPORT Line, FillRectangle, GrafText;
  23. FROM GEMGlobals IMPORT GemChar, MButtonSet, msBut1, LineType, SpecialKeySet;
  24. IMPORT SystemError, WindowBase;
  25. FROM EventHandler IMPORT FlushEvents, InstallWatchDog, WatchDogCarrier,
  26.         EventProc;
  27. FROM AESEvents IMPORT mouseButton;
  28. FROM SysUtil0 IMPORT VarEqual;
  29.  
  30. TYPE    CellWindow = POINTER TO RECORD
  31.                        win: WindowBase.Window;
  32.                        cellEnv: ADDRESS;
  33.                        cellW, cellH: INTEGER;
  34.                        cellsX, cellsY: INTEGER;
  35.                        drawBorders: BOOLEAN;
  36.                        suppressUpdate: INTEGER; (* nur Updates, wenn Null *)
  37.                        (* mustNotCopy: INTEGER;    (* wenn # 0, Neuzeichnen! *) *)
  38.                        updateCell: UpdateCellProc;
  39.                        activateCell: ActivateCellProc;
  40.                        closeCellWindow: CloseCellWdwProc;
  41.                      END;
  42.  
  43. CONST   maxWdw = 9;
  44.  
  45. VAR     wdws: ARRAY [0..maxWdw] OF CellWindow;
  46.         wins: ARRAY [0..maxWdw] OF WindowBase.Window;
  47.         winEnvOffs: LONGCARD;
  48.  
  49. VAR     stdMFDB: MemFormDef;
  50.         device: DeviceHandle;
  51.         gemHdl: GemHandle;
  52.         ok: BOOLEAN;
  53.  
  54.  
  55. PROCEDURE pointToCellPos (    wdw    :CellWindow;
  56.                               p      :Point;
  57.                           VAR column,
  58.                               row    : INTEGER;
  59.                           VAR success: BOOLEAN);
  60.  
  61.   VAR   lp: LongPnt;
  62.   
  63.   BEGIN
  64.     WITH wdw^ DO
  65.       WindowBase.CalcWindowCoor (win, p, lp, success);
  66.       IF NOT success THEN RETURN END;
  67.       column := SHORT (lp.x DIV LONG (cellW));
  68.       row := SHORT (lp.y DIV LONG (cellH));
  69.       IF column >= cellsX THEN
  70.         column := cellsX - 1
  71.       END;
  72.       IF row >= cellsY THEN
  73.         row := cellsY - 1
  74.       END;
  75.     END;
  76.   END pointToCellPos;
  77.  
  78. PROCEDURE cellToPointPos (wdw: CellWindow; column, row: INTEGER): Point;
  79.   (*  Calculates the real pixel coors of the cell coors *)
  80.   VAR   result: Point;
  81.   BEGIN
  82.     WITH wdw^ DO
  83.       WindowBase.CalcScreenCoor (win,
  84.                                  LPnt (LONG (column) * LONG (cellW),
  85.                                        LONG (row) * LONG (cellH)), result, ok);
  86.     END;
  87.     RETURN result
  88.   END cellToPointPos;
  89.  
  90. VAR lastFrameW, lastFrameH: INTEGER;
  91.  
  92. PROCEDURE update (win   : WindowBase.Window;
  93.                   env   : ADDRESS;
  94.                   source,
  95.                   dest,
  96.                   new   : Rectangle);
  97.  
  98.   VAR   wdw: CellWindow;
  99.         oldHdl: GemHandle;
  100.         blankOnce: BOOLEAN; (* alles auf einmal löschen oder zellenweise *)
  101.         x, y, l, t, r, b: INTEGER;
  102.         cell: CellPnt;
  103.         p, p2: Point;
  104.         clip, frame: Rectangle;
  105.  
  106.   BEGIN (*update*)
  107.     wdw:= env;
  108.     IF wdw^.win # win THEN HALT END;
  109.     
  110.     IF wdw^.suppressUpdate # 0 THEN RETURN END;
  111.     
  112.     IF source.w # 0 THEN
  113.       (*IF wdw^.mustNotCopy = 0 THEN*)
  114.       DisableClipping (device);
  115.       CopyOpaque (device, ADR (stdMFDB), ADR (stdMFDB), source, dest, onlyS);
  116.       (*ELSE
  117.           (* Kopieren nicht erlaubt - neuzeichnen! *)
  118.           IF (new.w <= 0) OR (new.h <= 0) THEN
  119.             new:= dest
  120.           ELSE
  121.             new:= FrameRects (new, dest);
  122.           END
  123.         END
  124.       *)
  125.     END;
  126.     
  127.     IF (new.w <= 0) OR (new.h <= 0) THEN RETURN END;
  128.     
  129.     oldHdl:= CurrGemHandle ();
  130.     SetCurrGemHandle (gemHdl, ok);
  131.     IF NOT ok THEN HALT END;
  132.     
  133.     frame.w:= wdw^.cellW;
  134.     frame.h:= wdw^.cellH;
  135.     
  136.     blankOnce:= (frame.w < 64) OR (frame.h < 30)
  137.              OR (lastFrameW # frame.w) OR (lastFrameH # frame.h);
  138.     
  139.     lastFrameW:= frame.w;
  140.     lastFrameH:= frame.h;
  141.     
  142.     IF blankOnce THEN
  143.       SetFillColor (device, white);
  144.       FillRectangle (device, new);
  145.     END;
  146.     
  147.     pointToCellPos (wdw, Pnt (new.x, new.y), l, t, ok);
  148.     pointToCellPos (wdw, Pnt (new.x+new.w-1, new.y+new.h-1), r, b, ok);
  149.     FOR y:= t TO b DO
  150.       FOR x:= l TO r DO
  151.         p:= cellToPointPos (wdw, x, y);
  152.         frame.x:= p.x;
  153.         frame.y:= p.y;
  154.         clip:= ClipRect (frame, new);
  155.         IF VarEqual (clip, frame) THEN
  156.           DisableClipping (device);
  157.           (* wird sowieso übermalt:
  158.             IF ~blankOnce THEN SetFillColor (device, white); FillRectangle (device, clip); END;
  159.           *)
  160.         ELSE
  161.           (* wird sowieso übermalt:
  162.             IF ~blankOnce THEN SetFillColor (device, white); FillRectangle (device, clip); END;
  163.           *)
  164.           SetClipping (device, new);
  165.         END;
  166.         cell.x:= x;
  167.         cell.y:= y;
  168.         wdw^.updateCell (wdw, wdw^.cellEnv, cell, frame, clip, device);
  169.       END(*FOR*);
  170.       IF ~blankOnce THEN
  171.         (* übriger rechter Bereich, der nicht zu Zellen gehört, löschen *)
  172.         x:= r+1;
  173.         p:= cellToPointPos (wdw, x, y);
  174.         frame.x:= p.x;
  175.         frame.y:= p.y;
  176.         clip:= ClipRect (frame, new);
  177.         IF (clip.w > 0) & (clip.h > 0) THEN
  178.           SetFillColor (device, white);
  179.           FillRectangle (device, clip);
  180.         END
  181.       END;
  182.     END(*FOR*);
  183.     IF ~blankOnce THEN
  184.       (* übriger unterer Bereich, der nicht zu Zellen gehört, löschen *)
  185.       SetFillColor (device, white);
  186.       y:= b+1;
  187.       FOR x:= l TO r DO
  188.         p:= cellToPointPos (wdw, x, y);
  189.         frame.x:= p.x;
  190.         frame.y:= p.y;
  191.         clip:= ClipRect (frame, new);
  192.         IF (clip.w > 0) & (clip.h > 0) THEN
  193.           FillRectangle (device, clip);
  194.         END;
  195.       END
  196.     END;
  197.     
  198.     IF wdw^.drawBorders THEN
  199.       SetLineColor (device, black);
  200.       SetLineType (device, solidLn);
  201.       SetLineWidth (device, 1);
  202.       p:= cellToPointPos (wdw, l, t);
  203.       p2:= cellToPointPos (wdw, r+1, b+1);
  204.       SetClipping (device, new);
  205.       x:= p.x + wdw^.cellW-1;
  206.       REPEAT
  207.         Line (device, Point {x, p.y}, Point {x, p2.y});
  208.         INC (x, wdw^.cellW)
  209.       UNTIL x >= p2.x;
  210.       y:= p.y + wdw^.cellH-1;
  211.       REPEAT
  212.         Line (device, Point {p.x, y}, Point {p2.x, y});
  213.         INC (y, wdw^.cellH);
  214.       UNTIL y >= p2.y;
  215.     END;
  216.     
  217.     DisableClipping (device);
  218.     
  219.     SetCurrGemHandle (oldHdl, ok);
  220.     IF NOT ok THEN HALT END;
  221.   END update;
  222.  
  223. PROCEDURE activated (win: WindowBase.Window; env: ADDRESS);
  224.  
  225.   END activated;
  226.  
  227. PROCEDURE close (win: WindowBase.Window; env: ADDRESS);
  228.  
  229.   VAR   wdw: CellWindow;
  230.  
  231.   BEGIN
  232.     wdw:= env;
  233.     IF wdw^.win # win THEN HALT END;
  234.     IF ADDRESS (wdw^.closeCellWindow) # NIL THEN
  235.       IF wdw^.closeCellWindow (wdw, wdw^.cellEnv) THEN
  236.         CloseCellWindow (wdw)
  237.       END;
  238.     END;
  239.   END close;
  240.  
  241. PROCEDURE checkSpec (    win   : WindowBase.Window;
  242.                          env   : ADDRESS;
  243.                      VAR spec  : WindowBase.WindowSpec;
  244.                          border: LongRect    );
  245.   
  246.   CONST cellAlign       = 8L;
  247.   
  248.   VAR   wdw: CellWindow;
  249.         amt: LONGINT;
  250.         ptr: ADDRESS;
  251.  
  252.   BEGIN
  253.     wdw:= env;
  254.     IF wdw^.win # win THEN HALT END;
  255.     WITH spec DO
  256.       IF visible.w > LONG (wdw^.cellsX) * LONG (wdw^.cellW) THEN
  257.         visible.w:= LONG (wdw^.cellsX) * LONG (wdw^.cellW)
  258.       END;
  259.       IF visible.h > LONG (wdw^.cellsY) * LONG (wdw^.cellH) THEN
  260.         visible.h:= LONG (wdw^.cellsY) * LONG (wdw^.cellH)
  261.       END;
  262.       (*  Umrechnen in Weltkoor. *)
  263.       INC (virtual.x, visible.x);
  264.       INC (virtual.y, visible.y);
  265.       visible.w:= virtual.x + visible.w - 1L;
  266.       visible.h:= virtual.y + visible.h - 1L;
  267.       border.w:= border.x + border.w - 1L;
  268.       border.h:= border.y + border.h - 1L;
  269.       IF virtual.x < border.x THEN virtual.x:= border.x END;
  270.       IF virtual.y < border.y THEN virtual.y:= border.y END;
  271.       IF virtual.x > border.w THEN virtual.x:= border.w END;
  272.       IF virtual.y > border.h THEN virtual.y:= border.h END;
  273.       IF visible.w < border.x THEN visible.w:= border.x END;
  274.       IF visible.h < border.y THEN visible.h:= border.y END;
  275.       IF visible.w > border.w THEN visible.w:= border.w END;
  276.       IF visible.h > border.h THEN visible.h:= border.h END;
  277.       visible.w:= visible.w - virtual.x + 1L;
  278.       visible.h:= visible.h - virtual.y + 1L;
  279.       
  280.       INC (virtual.x, cellAlign - 1L); DEC (virtual.x, virtual.x MOD cellAlign);
  281.       
  282.       DEC (virtual.x, visible.x);
  283.       DEC (virtual.y, visible.y);
  284.       
  285.       amt:= visible.x MOD LONG (wdw^.cellW);
  286.       INC (virtual.x, amt); DEC (visible.x, amt);
  287.       amt:= visible.y MOD LONG (wdw^.cellH);
  288.       INC (virtual.y, amt); DEC (visible.y, amt);
  289.       
  290.       (*
  291.         DEC (visible.w, visible.w MOD LONG (wdw^.cellW));
  292.         DEC (visible.h, visible.h MOD LONG (wdw^.cellH));
  293.       *)
  294.     END;
  295.   END checkSpec;
  296.  
  297. PROCEDURE scrollAmt (win    : WindowBase.Window;
  298.                      env    : ADDRESS;
  299.                      toDo   : WindowBase.WindowScrollMode): LONGINT;
  300.  
  301.   VAR   spec: WindowBase.WindowSpec;
  302.         wdw: CellWindow;
  303.  
  304.   BEGIN
  305.     wdw:= env;
  306.     IF wdw^.win # win THEN HALT END;
  307.     WindowBase.GetWindowSpec (win, spec);
  308.     CASE toDo OF
  309.       WindowBase.pageLeftWdw,
  310.       WindowBase.pageRightWdw  : RETURN spec.visible.w|
  311.       WindowBase.pageUpWdw,
  312.       WindowBase.pageDownWdw   : RETURN spec.visible.h|
  313.       WindowBase.columnLeftWdw,
  314.       WindowBase.columnRightWdw: RETURN wdw^.cellW|
  315.       WindowBase.rowUpWdw,
  316.       WindowBase.rowDownWdw    : RETURN wdw^.cellH|
  317.     END;
  318.   END scrollAmt;
  319.  
  320.  
  321. PROCEDURE setPosAndSize (wdw: CellWindow; x, y, w, h: INTEGER);
  322.   BEGIN
  323.     WITH wdw^ DO
  324.       IF x = -1 THEN x := WindowBase.CenterWdw ELSE x := x * cellW END;
  325.       IF y = -1 THEN y := WindowBase.CenterWdw ELSE y := y * cellH END;
  326.       IF w = -1 THEN w := WindowBase.MaxWdw ELSE w := w * cellW END;
  327.       IF h = -1 THEN h := WindowBase.MaxWdw ELSE h := h * cellH END;
  328.       WindowBase.SetWindowWorkArea (win, Rect (x, y, w, h))
  329.     END
  330.   END setPosAndSize;
  331.  
  332. PROCEDURE Enqueue (wdw: CellWindow; win: WindowBase.Window): BOOLEAN;
  333.   VAR n: CARDINAL;
  334.   BEGIN
  335.     FOR n:= 0 TO maxWdw DO
  336.       IF wdws[n] = NIL THEN
  337.         wdws[n]:= wdw;
  338.         wins[n]:= win;
  339.         RETURN TRUE
  340.       END
  341.     END;
  342.     RETURN FALSE
  343.   END Enqueue;
  344.  
  345. PROCEDURE Dequeue (wdw: CellWindow);
  346.   VAR n: CARDINAL;
  347.   BEGIN
  348.     FOR n:= 0 TO maxWdw DO
  349.       IF wdws[n] = wdw THEN
  350.         wdws[n]:= NIL;
  351.         wins[n]:= WindowBase.NoWindow;
  352.         RETURN
  353.       END
  354.     END;
  355.   END Dequeue;
  356.  
  357. PROCEDURE FindWdw (win: WindowBase.Window): CellWindow;
  358.   VAR n: CARDINAL;
  359.   BEGIN
  360.     FOR n:= 0 TO maxWdw DO
  361.       IF wins[n] = win THEN
  362.         RETURN wdws[n]
  363.       END
  364.     END;
  365.     RETURN NIL
  366.   END FindWdw;
  367.  
  368. PROCEDURE CreateCellWindow (VAR wdw            : CellWindow;
  369.                                 cellSizeX      : CARDINAL;
  370.                                 cellSizeY      : CARDINAL;
  371.                                 cellsX0        : CARDINAL;
  372.                                 cellsY0        : CARDINAL;
  373.                                 infoLine       : BOOLEAN;
  374.                                 cellBorders    : BOOLEAN;
  375.                                 updateServer   : UpdateCellProc;
  376.                                 activateServer : ActivateCellProc;
  377.                                 closeServer    : CloseCellWdwProc;
  378.                                 serverEnv      : ADDRESS);
  379.   
  380.   VAR baseElems: WindowBase.WdwElemSet;
  381.       spec: WindowBase.WindowSpec;
  382.       p: ADDRESS;
  383.       pw: POINTER TO CellWindow;
  384.       
  385.   BEGIN
  386.     NEW (wdw);
  387.     IF wdw # NIL THEN
  388.       WITH wdw^ DO
  389.         cellEnv:= serverEnv;
  390.         updateCell:= updateServer;
  391.         activateCell:= activateServer;
  392.         closeCellWindow:= closeServer;
  393.         cellW:= cellSizeX;
  394.         cellH:= cellSizeY;
  395.         cellsX:= cellsX0;
  396.         cellsY:= cellsY0;
  397.         drawBorders:= cellBorders;
  398.         suppressUpdate:= 0;
  399.         (*mustNotCopy:= 0;*)
  400.         baseElems:= WindowBase.WdwElemSet {WindowBase.sizeElem,
  401.           WindowBase.moveElem, WindowBase.scrollElem, WindowBase.titleElem};
  402.         IF infoLine THEN INCL (baseElems, WindowBase.infoElem) END;
  403.         IF ADDRESS (closeServer) # NIL THEN INCL (baseElems, WindowBase.closeElem) END;
  404.         WindowBase.CreateWindow (win, baseElems, update, checkSpec,
  405.                                  scrollAmt, activated, close, wdw);
  406.         IF WindowBase.WindowState (win) # WindowBase.okWdw THEN
  407.           DISPOSE (wdw);
  408.           RETURN
  409.         END;
  410.         (* 'env'-Feld in 'Window' finden, da dies unser 'CellWindow' ist *)
  411.         p:= ADDRESS(win);
  412.         winEnvOffs:= 0;
  413.         LOOP
  414.           IF winEnvOffs > 100 THEN HALT END;
  415.           pw:= p+winEnvOffs;
  416.           IF pw^ = wdw THEN EXIT END;
  417.           INC (winEnvOffs, 2)
  418.         END;
  419.         IF ~Enqueue (wdw, win) THEN
  420.           WindowBase.DeleteWindow (win);
  421.           DISPOSE (wdw);
  422.           RETURN
  423.         END;
  424.         WindowBase.GetWindowSpec (win, spec);
  425.         spec.virtual.w := LONG (cellsX) * LONG (cellW) + LONG (cellW) - 1;
  426.         spec.virtual.h := LONG (cellsY) * LONG (cellH) + LONG (cellH) - 1;
  427.         WindowBase.SetWindowSpec (win, spec);
  428.         setPosAndSize (wdw, -1, -1, -1, -1);
  429.       END;(*WITH*)
  430.     END
  431.   END CreateCellWindow;
  432.  
  433. PROCEDURE SpecifyCellWindow (wdw: CellWindow;
  434.                              cellSizeX, cellSizeY, cellsX0, cellsY0: CARDINAL;
  435.                              cellBorders: BOOLEAN);
  436.   VAR spec: WindowBase.WindowSpec; save: CellPnt; hor, ver: LONGINT;
  437.   BEGIN
  438.     save:= MidCell (wdw);
  439.     WITH wdw^ DO
  440.       IF (cellW # INT(cellSizeX)) OR (cellH # INT(cellSizeY))
  441.       OR (cellsX # INT(cellsX0)) OR (cellsY # INT(cellsY0)) THEN
  442.         INC (suppressUpdate);
  443.         drawBorders:= cellBorders;
  444.         cellW:= cellSizeX;
  445.         cellH:= cellSizeY;
  446.         cellsX:= cellsX0;
  447.         cellsY:= cellsY0;
  448.         WindowBase.GetWindowSpec (win, spec);
  449.         spec.virtual.w := LONG (cellsX) * LONG (cellW) + LONG (cellW) - 1;
  450.         spec.virtual.h := LONG (cellsY) * LONG (cellH) + LONG (cellH) - 1;
  451.         WindowBase.SetWindowSpec (win, spec);
  452.         SetMid (wdw, save);
  453.         FlushEvents ();
  454.         DEC (suppressUpdate);
  455.         WindowBase.RedrawWindow (wdw^.win);
  456.       END;
  457.     END;
  458.   END SpecifyCellWindow;
  459.  
  460. PROCEDURE DeleteCellWindow (VAR wdw: CellWindow);
  461.   BEGIN
  462.     IF wdw # NIL THEN
  463.       WindowBase.DeleteWindow (wdw^.win);
  464.       Dequeue (wdw);
  465.       DISPOSE (wdw);
  466.     END
  467.   END DeleteCellWindow;
  468.  
  469. PROCEDURE OpenCellWindow (wdw: CellWindow);
  470.   BEGIN
  471.     IF wdw # NIL THEN
  472.       IF WindowBase.hiddenWdw IN WindowBase.WindowFlags (wdw^.win) THEN
  473.         WindowBase.OpenWindow (wdw^.win);
  474.       ELSIF NOT (WindowBase.topWdw IN WindowBase.WindowFlags (wdw^.win)) THEN
  475.         WindowBase.PutWindowOnTop (wdw^.win);
  476.       END
  477.     END;
  478.   END OpenCellWindow;
  479.  
  480. PROCEDURE CloseCellWindow (wdw: CellWindow);
  481.   BEGIN
  482.     IF wdw # NIL THEN
  483.       IF NOT (WindowBase.hiddenWdw IN WindowBase.WindowFlags (wdw^.win)) THEN
  484.         WindowBase.CloseWindow (wdw^.win)
  485.       END
  486.     END;
  487.   END CloseCellWindow;
  488.  
  489. PROCEDURE RedrawCell (wdw   : CellWindow;
  490.                       pos   : CellPnt);
  491.   VAR frame: LongRect;
  492.   BEGIN
  493.     IF wdw # NIL THEN
  494.       frame:= LongRect {LONG(INT(pos.x))*LONG(wdw^.cellW),
  495.                         LONG(INT(pos.y))*LONG(wdw^.cellH),
  496.                         wdw^.cellW, wdw^.cellH};
  497.       WindowBase.UpdateWindow (wdw^.win, update, wdw, frame, WindowBase.noCopyWdw, 0);
  498.     END;
  499.   END RedrawCell;
  500.  
  501. PROCEDURE Win (wdw: CellWindow): WindowBase.Window;
  502.   BEGIN
  503.     RETURN wdw^.win
  504.   END Win;
  505.  
  506. PROCEDURE CellWin (win: WindowBase.Window): CellWindow;
  507.   VAR p: POINTER TO CellWindow;
  508.   BEGIN
  509.     IF win # WindowBase.NoWindow THEN
  510.       p:= ADDRESS (win) + winEnvOffs;
  511.       IF p^^.win = win THEN
  512.         RETURN p^
  513.       END;
  514.     END;
  515.     RETURN NIL
  516.   END CellWin;
  517.  
  518. PROCEDURE SetTopLeft (wdw: CellWindow; cell: CellPnt);
  519.   VAR hor, vert: LONGINT;
  520.   BEGIN
  521.     hor:= INT (LONG (cell.x)) * LONG (wdw^.cellW);
  522.     vert:= INT (LONG (cell.y)) * LONG (wdw^.cellH);
  523.     WindowBase.SetWindowSliderPos (wdw^.win, hor, vert);
  524.     (*
  525.       INC (wdw^.suppressUpdate);
  526.       FlushEvents ();
  527.       DEC (wdw^.suppressUpdate);
  528.       WindowBase.RedrawWindow (wdw^.win);
  529.     *)
  530.   END SetTopLeft;
  531.  
  532. PROCEDURE TopLeftCell (wdw: CellWindow): CellPnt;
  533.   VAR hor, vert: LONGINT; cell: CellPnt;
  534.   BEGIN
  535.     WindowBase.GetWindowSliderPos (wdw^.win, hor, vert);
  536.     cell.x:= SHORT (hor DIV LONG (wdw^.cellW));
  537.     cell.y:= SHORT (vert DIV LONG (wdw^.cellH));
  538.     RETURN cell
  539.   END TopLeftCell;
  540.  
  541. PROCEDURE VisibleCells (wdw: CellWindow): CellRect;
  542.   VAR spec: WindowBase.WindowSpec; r: CellRect;
  543.   BEGIN
  544.     WITH wdw^ DO
  545.       WindowBase.GetWindowSpec (win, spec);
  546.       r.x:= SHORT ((spec.visible.x) DIV LONG (cellW));
  547.       r.y:= SHORT ((spec.visible.y) DIV LONG (cellH));
  548.       r.w:= SHORT ((spec.visible.w) DIV LONG (cellW));
  549.       r.h:= SHORT ((spec.visible.h) DIV LONG (cellH));
  550.     END;
  551.     RETURN r
  552.   END VisibleCells;
  553.  
  554. PROCEDURE MidCell (wdw: CellWindow): CellPnt;
  555.   VAR spec: WindowBase.WindowSpec; cell: CellPnt;
  556.   BEGIN
  557.     WITH wdw^ DO
  558.       WindowBase.GetWindowSpec (win, spec);
  559.       cell.x:= SHORT ((spec.visible.x + spec.visible.w DIV 2) DIV LONG (cellW));
  560.       cell.y:= SHORT ((spec.visible.y + spec.visible.h DIV 2) DIV LONG (cellH));
  561.     END;
  562.     RETURN cell
  563.   END MidCell;
  564.  
  565. PROCEDURE SetMid (wdw: CellWindow; cell: CellPnt);
  566.   VAR spec: WindowBase.WindowSpec; hor, ver: LONGINT;
  567.   BEGIN
  568.     WITH wdw^ DO
  569.       WindowBase.GetWindowSpec (win, spec);
  570.       hor:= INT (LONG (cell.x+1)) * LONG (wdw^.cellW) - spec.visible.w DIV 2;
  571.       ver:= INT (LONG (cell.y+1)) * LONG (wdw^.cellH) - spec.visible.h DIV 2;
  572.       IF hor < 0 THEN hor:= 0 END;
  573.       IF ver < 0 THEN ver:= 0 END;
  574.       WindowBase.SetWindowSliderPos (win, hor, ver);
  575.     END
  576.   END SetMid;
  577.  
  578. PROCEDURE DevHdl (): DeviceHandle;
  579.   BEGIN
  580.     RETURN device
  581.   END DevHdl;
  582.  
  583. PROCEDURE SuppressUpdate (wdw: CellWindow);
  584.   BEGIN
  585.     INC (wdw^.suppressUpdate);
  586.   END SuppressUpdate;
  587.  
  588. PROCEDURE AllowUpdate (wdw: CellWindow; force: BOOLEAN);
  589.   BEGIN
  590.     DEC (wdw^.suppressUpdate);
  591.     IF force OR (wdw^.suppressUpdate < 0) THEN wdw^.suppressUpdate:= 0 END;
  592.   END AllowUpdate;
  593.  
  594. PROCEDURE butHdler (clicks: CARDINAL; loc: Point; buts: MButtonSet;
  595.                     keys: SpecialKeySet): BOOLEAN;
  596.  
  597.   VAR res: WindowBase.DetectWdwResult;
  598.       win: WindowBase.Window;
  599.       wdw: CellWindow;
  600.       x, y: INTEGER;
  601.       frame: Rectangle;
  602.       p: Point;
  603.       ok: BOOLEAN;
  604.       info: ButEvRec;
  605.       
  606.   BEGIN
  607.     WindowBase.DetectWindow (wins, 0, loc, win, res);
  608.     IF res = WindowBase.foundWdwDWR THEN
  609.       wdw:= FindWdw (win);
  610.       IF wdw = NIL THEN HALT END;
  611.       pointToCellPos (wdw, loc, x, y, ok);
  612.       IF ok THEN
  613.         p:= cellToPointPos (wdw, x, y);
  614.         frame:= Rectangle {p.x, p.y, wdw^.cellW, wdw^.cellH};
  615.         info:= ButEvRec {clicks, loc, buts, keys};
  616.         RETURN wdw^.activateCell (wdw, wdw^.cellEnv, CellPnt{x,y},
  617.                         frame, info, device);
  618.       END;
  619.     END;
  620.     RETURN TRUE (* -> Event weitergeben *)
  621.   END butHdler;
  622.  
  623. VAR wdhandle: WatchDogCarrier;
  624.  
  625. BEGIN
  626.   stdMFDB.start := NIL;
  627.   InitGem (RC, device, ok);
  628.   IF ok THEN
  629.     gemHdl:= CurrGemHandle ();
  630.   ELSE
  631.     SystemError.OutOfMemory ();
  632.   END;
  633.   InstallWatchDog (wdhandle, EventProc {mouseButton, butHdler});
  634. END View2Dim.
  635.